home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / X11 / tclMotif-1.4 / send / programs / xmSend5.err.c < prev    next >
C/C++ Source or Header  |  1995-06-29  |  6KB  |  224 lines
  1. /*
  2.  * A Motif program to send and receive messages internally, to its own
  3.  * buttons. This one has two local interpreters, and three registered names
  4.  *
  5.  * This is semantically incorrect - Tk only allows one name to be registered
  6.  * per interpreter. Why? I dunno...
  7.  * John Ousterhout has put this restriction on his list of "things to think
  8.  * about" for the next generation of "send".
  9.  */
  10.  
  11. #include <stdio.h>
  12. #include <Xm/Label.h>
  13. #include <Xm/PushB.h>
  14. #include <Xm/RowColumn.h>
  15. #include "../tclXtSend.h"
  16.  
  17. void
  18. SendTo1(w, clientData, callData)
  19.     Widget w;
  20.     XtPointer clientData;
  21.     XtPointer callData;
  22. {
  23.     Tcl_Interp *interp = (Tcl_Interp *) clientData;
  24.     char sendCommand[1024];
  25.  
  26.     strcpy(sendCommand,
  27.         "send xmSend5.1 incrementLabel1");
  28.     if (Tcl_Eval(interp, sendCommand) != TCL_OK)
  29.     fprintf(stderr, "send failed: %s\n", interp->result);
  30. }
  31.  
  32. void
  33. SendTo2(w, clientData, callData)
  34.     Widget w;
  35.     XtPointer clientData;
  36.     XtPointer callData;
  37. {
  38.     Tcl_Interp *interp = (Tcl_Interp *) clientData;
  39.     char sendCommand[1024];
  40.  
  41.     strcpy(sendCommand,
  42.         "send xmSend5.1 incrementLabel1");
  43.     if (Tcl_Eval(interp, sendCommand) != TCL_OK)
  44.     fprintf(stderr, "send failed: %s\n", interp->result);
  45.  
  46.     strcpy(sendCommand,
  47.         "send xmSend5.2 incrementLabel2");
  48.     if (Tcl_Eval(interp, sendCommand) != TCL_OK)
  49.     fprintf(stderr, "send failed: %s\n", interp->result);
  50. }
  51.  
  52. void
  53. SendTo3(w, clientData, callData)
  54.     Widget w;
  55.     XtPointer clientData;
  56.     XtPointer callData;
  57. {
  58.     Tcl_Interp *interp = (Tcl_Interp *) clientData;
  59.     char sendCommand[1024];
  60.  
  61.     strcpy(sendCommand,
  62.         "send xmSend5.1 incrementLabel1\n\
  63.          send xmSend5.2 incrementLabel2\n\
  64.          send xmSend5.3 incrementLabel3");
  65.     if (Tcl_Eval(interp, sendCommand) != TCL_OK)
  66.     fprintf(stderr, "send failed: %s\n", interp->result);
  67. }
  68.  
  69.  
  70. char incrementLabelCmd[] = "\
  71.   proc incrementLabel1 {} { \n\
  72.     getLabel1 value \n\
  73.     incr value \n\
  74.     setLabel1 $value \n\
  75.   } \n\
  76.   proc incrementLabel2 {} { \n\
  77.     getLabel2 value \n\
  78.     incr value \n\
  79.     setLabel2 $value \n\
  80.   } \n\
  81.   proc incrementLabel3 {} { \n\
  82.     getLabel3 value \n\
  83.     incr value \n\
  84.     setLabel3 $value \n\
  85.   } \
  86. ";
  87.  
  88. int
  89. SetLabel(clientData, interp, argc, argv)
  90.     ClientData *clientData;
  91.     Tcl_Interp *interp;
  92.     int argc;
  93.     char **argv;
  94. {
  95.     XmString xmstr;
  96.     Widget w = (Widget) clientData;
  97.  
  98.     if (argc < 2) {
  99.     Tcl_SetResult(interp, "setLabel label", TCL_STATIC);
  100.     return TCL_ERROR;
  101.     }
  102.  
  103. fprintf(stderr, "**Setting label to %s\n", argv[1]);
  104.     xmstr = XmStringCreateLocalized(argv[1]);
  105.     XtVaSetValues(w, XmNlabelString, xmstr, NULL);
  106.     XmStringFree(xmstr);
  107.  
  108.     return TCL_OK;
  109. }
  110.  
  111. int
  112. GetLabel(clientData, interp, argc, argv)
  113.     ClientData *clientData;
  114.     Tcl_Interp *interp;
  115.     int argc;
  116.     char **argv;
  117. {
  118.     XmString xmstr;
  119.     String str;
  120.     Widget w = (Widget) clientData;
  121.  
  122.     if (argc < 2) {
  123.     Tcl_SetResult(interp, "getLabel \"label\"", TCL_STATIC);
  124.     return TCL_ERROR;
  125.     }
  126.  
  127.     XtVaGetValues(w, XmNlabelString, &xmstr, NULL);
  128.     XmStringGetLtoR(xmstr, XmFONTLIST_DEFAULT_TAG, &str);
  129.     Tcl_SetVar(interp, argv[1], str, 0);
  130.  
  131.     XtFree(str);
  132.     XmStringFree(xmstr);
  133.  
  134.     return TCL_OK;
  135. }
  136.  
  137. int
  138. main(argc, argv)
  139.     int argc;
  140.     char **argv;
  141. {
  142.     Widget toplevel;
  143.     Widget rc;
  144.     Widget button;
  145.     Widget label;
  146.     Tcl_Interp *interp1, *interp2;
  147.     XtAppContext app;
  148.  
  149.     toplevel = XtAppInitialize(&app, "XmSend", NULL, 0, &argc, argv,
  150.                 NULL, NULL, 0);
  151.  
  152.     interp1 = Tcl_CreateInterp();
  153.     interp2 = Tcl_CreateInterp();
  154.  
  155.     if (TclXtSend_RegisterInterp(interp1, "xmSend5.1", toplevel) == TCL_ERROR) {
  156.     fprintf(stderr, "couldn't register interpreter 5.1\n");
  157.     exit(1);
  158.     }
  159.  
  160.     if (TclXtSend_RegisterInterp(interp1, "xmSend5.2", toplevel) == TCL_ERROR) {
  161.     fprintf(stderr, "couldn't register interpreter 5.1\n");
  162.     exit(1);
  163.     }
  164.  
  165.     if (TclXtSend_RegisterInterp(interp2, "xmSend5.3", toplevel) == TCL_ERROR) {
  166.     fprintf(stderr, "couldn't register interpreter 5.1\n");
  167.     exit(1);
  168.     }
  169.  
  170.     rc = XmCreateRowColumn(toplevel, "rc", NULL, 0);
  171.     XtManageChild(rc);
  172.     XtVaSetValues(rc,
  173.         XmNpacking, XmPACK_COLUMN,
  174.         XmNnumColumns, 2,
  175.         NULL);
  176.  
  177.     button = XmCreatePushButton(rc, "Incr label1", NULL, 0);
  178.     XtManageChild(button);
  179.     XtAddCallback(button, XmNactivateCallback, SendTo1, (XtPointer) interp1);
  180.  
  181.     button = XmCreatePushButton(rc, "Incr 1&2", NULL, 0);
  182.     XtManageChild(button);
  183.     XtAddCallback(button, XmNactivateCallback, SendTo2, (XtPointer) interp1);
  184.  
  185.     button = XmCreatePushButton(rc, "Incr 1&2&3", NULL, 0);
  186.     XtManageChild(button);
  187.     XtAddCallback(button, XmNactivateCallback, SendTo3, (XtPointer) interp2);
  188.  
  189.     label = XmCreateLabel(rc, "1", NULL, 0);
  190.     XtManageChild(label);
  191.     Tcl_CreateCommand(interp1, "setLabel1", SetLabel, (ClientData *) label,
  192.         (Tcl_CmdDeleteProc *) NULL);
  193.     Tcl_CreateCommand(interp1, "getLabel1", GetLabel, (ClientData *) label,
  194.         (Tcl_CmdDeleteProc *) NULL);
  195.  
  196.     label = XmCreateLabel(rc, "2", NULL, 0);
  197.     XtManageChild(label);
  198.     Tcl_CreateCommand(interp1, "setLabel2", SetLabel, (ClientData *) label,
  199.         (Tcl_CmdDeleteProc *) NULL);
  200.     Tcl_CreateCommand(interp1, "getLabel2", GetLabel, (ClientData *) label,
  201.         (Tcl_CmdDeleteProc *) NULL);
  202.  
  203.     label = XmCreateLabel(rc, "3", NULL, 0);
  204.     XtManageChild(label);
  205.     Tcl_CreateCommand(interp2, "setLabel3", SetLabel, (ClientData *) label,
  206.         (Tcl_CmdDeleteProc *) NULL);
  207.     Tcl_CreateCommand(interp2, "getLabel3", GetLabel, (ClientData *) label,
  208.         (Tcl_CmdDeleteProc *) NULL);
  209.  
  210.     XtRealizeWidget(toplevel);
  211.  
  212.     /*
  213.      * Create tcl commands based in C, and then load a procedure
  214.      */
  215.     if (Tcl_Eval(interp1, incrementLabelCmd) != TCL_OK)
  216.     fprintf(stderr, "couldn't load cmds: %s\n", interp1->result);
  217.  
  218.     if (Tcl_Eval(interp2, incrementLabelCmd) != TCL_OK)
  219.     fprintf(stderr, "couldn't load cmds: %s\n", interp2->result);
  220.  
  221.  
  222.     XtAppMainLoop(app);
  223. }
  224.